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DIRECTORY 

AltoDefs: FROM "altodefs" USING [BYTE, charlength, wordlength], 

Code: FROM "code" USING [curctxlvl, f irstcaseselread], 

CodeDefs: FROM "codedefs" USING [BDOComponent , BDOComponentNames, BDOIndex, BDOItem, BDONull , ChunkBa 
**se, FullBitAddress, GetChunk, InUseThread, Lexeme, 1TOS, topostack], 

ComData: FROM "comdata" USING [typelNTEGER] , 

ControlDefs: FROM "controldef s M USING [FieldDescriptor , framelink, globalbase, localbase], 

FOpCodes: FROM "fopcodes" USING [qADD, qAND, qDADD, qGADRB, qLADRB, qLG, qLGD, qLI, qLL, qLLD, qPOP, 
**qPUSH, qR, qRD, qRDL, qRF, qRFC, qRFL, qRIG, qRIGL, qRIL, qRILL, qRL, qRXGL, qRXL, qRXLL, qSG, qSGD, 
**qSL, qSLD, qW, qWD, qWDL, qWF, qWFL, qWIG, qWIGL, qWIL, qWILL, qWL, qWXGL, qWXL, qWXLL], 

LitDefs: FROM M litdefs M USING [FindLiteral , LTIndex], 

OpCodeParams: FROM "opcodeparams" USING [HB, LocalHB, GlobalHB], 

P5ADefs: FROM "p5adefs M USING [bl tnwordsf romstack, CioutO, Cioutl, Ciout2, gentemplex, operandtype, P 
**5Error, pop, RequireStack, sCassign, tree! iteral , tree! iteral value], 

P5BDefs: FROM "p5bdefs" USING [Cexp, Cregload, Ipushlex, MWConstant, pushlex, pushlitval, pushrhs], 

P5StmtExprDefs: FROM "p5stmtexprdef s", 

SymDefs: FROM "symdefs" USING [BitAddress, ContextLevel, CSEIndex, CTXIndex, ctxtype, HTIndex, ISEInd 
**ex, 1G, 1Z, SEIndex, setype], 

SymTabDefs: FROM "symtabdef s" USING [BitsForType, NormalType, UnderType, WordsForType], 

TableDefs: FROM "tabledef s" USING [TableBase, TableNotif ier], 

TreeDefs: FROM "treedefs" USING [empty, freenode, mlpop, mlpush, pushlittree, pushtree, setattr, seti 
**nfo, Treelndex, TreeLink, treetype]; 

DEFINITIONS FROM CodeDefs; " 

Address: PROGRAM 

IMPORTS MPtr: ComData, CPtr: Code, CodeDefs, LitDefs, P5ADefs, P5BDefs, SymTabDefs, TreeDefs 

EXPORTS CodeDefs, P5ADefs, P5StmtExprDef s = 
BEGIN 
OPEN P5ADefs t P5BDefs; 

-- imported definitions 

BYTE: TYPE - AUoDef S.BYTE; 

wordlength: CARDINAL ■ AUoDef s. wordlength; 

charlength: CARDINAL - AUoDef s. charlength; 

framelink: CARDINAL * ControlDef s.f ramel ink; 
globalbase: CARDINAL - ControlDef s .globalbase; 
localbase: CARDINAL ■ ControlDef s . localbase; 

BitAddress: TYPE ■ SymDefs . BitAddress; 
ContextLevel: TYPE = SymDefs .ContextLevel ; 
CTXIndex: TYPE - SymDefs .CTXIndex; 
HTIndex: TYPE - SymDefs .HTIndex; 
ISEIndex: TYPE - SymDefs. ISEIndex; 
CSEIndex: TYPE = SymDefs .CSEIndex; 
1G: ContextLevel * SymDefs. 1G; 
1Z: ContextLevel = SymDefs. 1Z; 
SEIndex: TYPE = SymDefs .SEIndex; 

Treelndex: TYPE » TreeDefs. Treelndex; 
TreeLink: TYPE = TreeDefs . TreeLink; 
empty: TreeLink ■ TreeDefs. empty; 

LTIndex: TYPE * Li tDefs .LTIndex; 

InvalidBDOItemRelease: SIGNAL « CODE; 
AddressingError: SIGNAL « CODE; 

BDOItemlist: BDOIndex; 

WordZeroBDOComponent, TosBDOComponent: BDOComponent; 

tb: TableDefs. TableBase; -- tree base (local copy) 

seb: TableDefs .TableBase; -- semantic entry base (local copy) 

ctxb: TableDefs. TableBase; -- context entry base (local copy) 

cb: ChunkBase; ~- code base (local copy) 

AddressNotify: PUBLIC TableDefs .TableNotif ier - 

BEGIN -- called by Code whenever table area is repacked 
seb <- base[SymDefs. setype]; 
ctxb <- base[SymDefs. ctxtype]; 
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tb «- base[TreeDefs.treetype]; 

cb 4- LOOPHOLE[tb]; 

RETURN 

END; 

AddressError: PROCEDURE » BEGIN SIGNAL AddressingError ; RETURN END; 

Addresslnit: PUBLIC PROCEDURE ■ 

BEGIN -- called by Cmodule to init stuff in Addr 
BDOcount «- BDOcard <- 0; 
BDOItemlist *- BDONull ; 
TosBDOComponent «- 

BDOComponent[level : 1TOS, posn: FullBitAddress[0, 0], size: wordlength]; 
WordZeroBDOComponent «- 

BDOComponent[level : 1Z, posn: FullBitAddress[0, 0], size: wordlength]; 
RETURN 
END; 

InvalidField: SIGNAL [RECORD[p,s: BYTE]] « CODE; 

FieldParam: PUBLIC PROCEDURE [r: BDOIndex] RETURNS [WORD] ■ 
BEGIN 

fd: ControlDefs.FieldDescriptor; 
p: CARDINAL «- cb[r] . of f set . posn . bd; 
s: CARDINAL 4- cb[r] .of f set . size; 
fd 4- [offset: 0, 

posn: p, 

size* s"l* 
IF p+s > wordlength THEN SIGNAL Inval idFiel d[[p, s]]; 
RETURN [LOOPHOLE[fd]]; 
END; 

addfulladdrtobits: PUBLIC PROCEDURE [f: FullBitAddress, b: CARDINAL] RETURNS [rf: FullBitAddress] 
BEGIN 
v: CARDINAL 4- f.bd + b MOD wordlength; 

rf.bd *• v MOD wordlength; 

rf.wd 4- f.wd + b/wordlength + v/wordlength; 

RETURN 

END; 

fulladdress: PROCEDURE [a: BitAddress] RETURNS [rf: FullBitAddress] - 
BEGIN 

rf.wd 4- a.wd; rf.bd 4- a.bd; 
RETURN 
END; 

rmakeBDOItem: PUBLIC PROCEDURE [1: Lexeme] RETURNS [BDOIndex] ■ 
BEGIN -- same as makeBDOItem, but returns BDOIndex 
RETURN [makeBDOItem[l].lexbdoi]; 
END; 

makeBDOItem: PUBLIC PROCEDURE [1: Lexeme] RETURNS [bdo Lexeme] « 
BEGIN -- forces 1 into lexeme-record format 
r: BDOIndex; 

WITH incomingl: 1 SELECT FROM 
bdo ■> RETURN[incomingl]; 
other => WITH incomingl SELECT FROM 
register »> 

BEGIN Cregload[lexrn]; RETURN [makeBDOItem[topostack]] END; 
byte -> 

BEGIN pushlex[l]; RETURN [makeBDOItem[topostack]] END; 
ENDCASE »> P5ADefs.P5Error[321]; 
literal a > 

BEGIN pushlex[l]; RETURN [makeBDOItem[topostack]] END; 
se ■> 
BEGIN 

r 4- genBDOItem[]; 

IF incomingl - topostack THEN cb[r]. offset «- TosBDOComponent 
ELSE 

cb[r]. offset 4- BDOComponent[level : (ctxb+(seb+incomingl . lexsei) .ctxnum) .ctxlevel f 
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posn: ful 1address[(seb+incomingl . lexsei) . idvalue], 
size: (seb+ incoming! .lexsei) . idinfo]; 
END; 
ENDCASE; 
cb[r].tag «- o; 
RETURN[Lexeme[bdo[r]]]; 
END; 

copyBDOItem: PUBLIC PROCEDURE [r: BDOIndex] RETURNS [rr: BDOIndex] - 
BEGIN -- returns rr as a copy of r 
rr «- genBDOItem[]; 
cb[rr] ♦• cb[r]; 
RETURN 
END; 

maketsonBDOItem: PUBLIC PROCEDURE [t: TreeLink] RETURNS [bdo Lexeme] ■ 
BEGIN -- another interface to makeBDOItem 
RETURN[makeBDOItem[Cexp[t]]] 
END; 

makeTOSaddrBDOItem: PUBLIC PROCEDURE [psize: CARDINAL] RETURNS [r: BDOIndex] 
BEGIN -- makes a rec-lexeme for an address on TOS 
r *• genBDOItem[]; 
cb[r].base «- TosBDOComponent; 
cb[r]. base, size <- Ful !WordBits[psize]; 
cb[r]. offset <- WordZeroBDOComponent; 
cb[r].tag <- bo; 
RETURN 
END; 

maketempaddrBDOItem: PUBLIC PROCEDURE [tlex: Lexeme] RETURNS [r: BDOIndex] - 
BEGIN -- makes a type-bo rec with temp (tlex) as pointer part 
r ♦- rmakeBDOItem[tlex]; 
cb[r].base *~ cb[r] .off set; 
cb[r].offset <- WordZeroBDOComponent; 
cb[r].tag ♦• bo; 
RETURN 
END; 

makeretlex: PUBLIC PROCEDURE [nwords, psize: CARDINAL] RETURNS [Lexeme] ■ 
BEGIN -- makes the appropriate TOS return of 1,2 or many values 
b: bdo Lexeme; 
SELECT nwords FROM 

1 => RETURN[topostack]; 

2 «> RETURN[makeTOSlex[2]]; 
ENDCASE -> 

BEGIN 

b +- Lexeme[bdo[makeTOSaddrBDOItem[psize]]]; 
cb[b. lexbdoi] .off set. size <- nwords*wordlength; 
RETURN [b] 
END; 
END; 

makeTOSlex: PUBLIC PROCEDURE [nwords: CARDINAL] RETURNS [bdo Lexeme] » 
BEGIN -- makes a record-type lexeme for nwords on stack 
r: BDOIndex «- genBDOItem[] ; 

cb[r].offset <- TosBDOComponent; 

cb[r] .tag ♦• o; 

cb[r] .off set. size «- nwords*wordlength; 

RETURN[Lexeme[bdo[r]]] 

END; 

Cload: PUBLIC PROCEDURE [r: BDOIndex] • 
BEGIN -- generates code for rhs 
SELECT cb[r].tag FROM 

o ■> Cvarload[r]; 

bo a > Cptrload[r]; 

bdo ■> Cindexedptrload[r]; 
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ENDCASE ■> BEGIN AddressError[] ; releaseBDOItem[r]; END; 
RETURN 
END; 

loadlexaddress: PUBLIC PROCEDURE [1: Lexeme] RETURNS [CARDINAL] ■ 
BEGIN -- interfaces to "loadaddress with lexeme parameter 
RETURN[loadaddress[rmakeBDOItem[l]]]; 
END; 

"loadseiaddress: PUBLIC PROCEDURE, [sei : ISEIndex] RETURNS [CARDINAL] ■ 
BEGIN -- interfaces to loadaddress with sei parameter 
RETURN[1oadlexaddress[Lexeme[se[lexsei : sei]]]]; 
END; 

loadtsonaddress: PUBLIC PROCEDURE [t: TreeLink] RETURNS [CARDINAL] ■ 
BEGIN -- interfaces to loadaddress with tson parameter 
RETURN[loadaddress[rmakeBDOItem[Cexp[t]]]]; 
END; 

loadaddress: PUBLIC PROCEDURE [r: BDOIndex] RETURNS [psize: CARDINAL] - 
BEGIN -- loads the address of the BDOItem's word zero onto stack 
tlex: se Lexeme; 

nwords: CARDINAL <- cb[r] .of f set . size/wordlength; 
delta: CARDINAL <- cb[r] .off set.posn. wd; 
long: BOOLEAN ♦- FALSE; 

IF cb[r].tag ■ bdo THEN 
BEGIN 
loaddisp: PROCEDURE - 

BEGIN 

pushcomponent[dispcomponent t r]; 

IF long AND cb[r], disp. size <« wordlength THEN 
Cioutl[FOpCodes.qLI, 0]; 

END; 
loadbase: PROCEDURE ■ 

BEGIN 

pushcomponent[basecomponent t r]; 

psize *- cb[r] .base. size; 

END; 
baseOnStack, dispOnStack: BOOLEAN «- FALSE; 
IF cb[r] .disp. size > wordlength THEN basedispcommute[r]; 
IF cb[r]. base. size > wordlength THEN 

BEGIN 

onstack: CARDINAL «- 0; 

IF cb[r]. base. level = 1T0S THEN 

BEGIN onstack «- onstack+(cb[r].base. size+wordlength-l)/wordlength; 

baseOnStack «■ TRUE; 

END; 

IF cb[r]. disp. level - 1TOS THEN 

BEGIN onstack «- onstack+(cb[r].disp. size+wordlength-l)/wordlength; 

dispOnStack «- TRUE; 

END; 

long ♦- TRUE; 

RequireStack[onstack] 

END; 
IF dispOnStack AND -baseOnStack THEN 

BEGIN loaddisp[]; loadbase[] END 
ELSE BEGIN loadbase[]; loaddisp[] END; 
IF long THEN 

BEGIN 

CioutO[FOpCodes . qDADD] ; 

END 
ELSE CioutO[FOpCodes.qADD]; 
cb[r].tag *- bo; 
END; 
IF cb[r].tag « bo THEN 
BEGIN 
IF cb[r]. base. size > wordlength THEN 

BEGIN long ♦- TRUE; IF delta # THEN RequireStack[0]; END; 
pushcomponent[basecomponent , r]; 
psize *- cb[r]. base. size; 
IF delta # THEN 
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BEGIN push! itval[cb[r], off set. posn.wd]; 
IF long THEN 

BEGIN Cioutl[FOpCodes.qLI, 0]; CioutO[FOpCodes.qDADD] END 
ELSE Ciout0[F0pCodes.qADD]; 
END; 

releaseBDOItem[r] ; 

RETURN 

END; 
psize «- wordlength; 
IF cb[r]. offset. level - 1T0S THEN 

BEGIN 

tlex «- bl tnwordsfromstack[nwords]; 

THROUGH [O..nwords) DO pop[] ENDL00P; 

releaseBDOItem[r]; 

[] <- loadlexaddress[tlex]; 

RETURN 

END; 
IF cb[r], offset. level # CPtr.curctxlvl AND cb[r]. offset. level # 1G THEN 

BEGIN 

GetFrame[r]; 

[] *- loadaddress[r]; 

RETURN 

END; 
IF cb[r]. offset. level - 1G THEN 

Cioutl[FOpCodes.qGADRB, cb[r] .off set .posn.wd] 
ELSE Cioutl[FOpCodes.qLADRB, cb[r] .off set .posn.wd] ; 
releaseBDOItem[r]; 
RETURN 
END; 

loadaddr: PROCEDURE [r: BDOIndex] ■ 

BEGIN — load the address in r (type o) onto stack and adjust offset of r 
rr: BDOIndex <- genBDOItem[] ; 



cb[rr]. offset <- cb[r]. offset; 

cb[rr]. tag «- o; 

[] *- loadaddress[rr]; 
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loadlex: PROCEDURE [1: ContextLevel , wordoffset, nwords: INTEGER] « 
BEGIN -- loads 1 or 2 words at level 1, offset wordoffset, onto stack 
rr: BDOIndex <- genBDOItem[] ; 

cb[rr].tag <- o; 
cb[rr]. offset ♦- 

BDOComponent[level : 1, posn: FullBitAddress[wd: wordoffset, bd: 0], size: nwords*wordlength]; 
Cvarload[rr]; 
RETURN 
END; 

Cvarload: PROCEDURE [r: BDOIndex] * 

BEGIN -- loads a type-o BDOItem onto stack 

OPEN FOpCodes; 

1: ContextLevel +- cb[r] .of f set. level ; 

v: CARDINAL «- cb[r] .of f set . posn .wd; 

s: CARDINAL; 

tlex: se Lexeme; 

g: BOOLEAN «- 1-1G; 

rr: BDOIndex; 

IF 1 - 1TOS THEN 
BEGIN 
IF cb[r]. offset. posn - FullBitAddress[0\0] AND cb[r]. offset. size >» wordlength THEN 

BEGIN releaseBDOItem[r]; RETURN END; 
tlex *r gentemplex[(cb[r].of f set. si ze+word length- 1) /wordlength] ; 
sCassign[tlex.lexsei]; 

THROUGH [1. .cb[r]. offset. posn.wd] DO CioutO[FOpCodes. qPOP] ENDLOOP; 
rr <- rmakeBDOItem[tlex]; 
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cb[rr]. offset. posn.bd <- cb[r]. offset .posn.bd; 

cb[rr], offset. size <- cb[r]. off set. size; 

releaseBDOItem[r]; 

Cvarload[rr]; 

RETURN 

END; 
IF ~g AND 1 CPtr.curctxIvl THEN 

BEGIN 

GetFrame[r]; 

Cload[r]; 

RETURN 

END; 
IF cb[r]. offset. size ■ 2*wordlength THEN 

BEGIN 

IF g THEN Cioutl[qLGD, v] ELSE Cioutl[qLLD, v]; 

releaseBDOItem[r]; 

RETURN 

END; 
IF cb[r]. offset. size > wordlength THEN 

BEGIN 

s <- cb[r] .offset. size/wordlength; 

v «- cb[r]. offset. posn.wd; 

WHILE s >» 2 DO loadlex[l, v, 2]; v <- v+2; s 4- s-2; ENDLOOP; 

IF s # THEN loadlex[l, v, 1]; 

releaseBDOItem[r]; 

RETURN 

END; 
IF cb[r]. offset. size < wordlength THEN 

BEGIN loadaddr[r]; Cptrload[r]; RETURN END; 
IF g THEN Cioutl[qLG t v] ELSE Cioutl[qLL, v]; 
releaseBDOItem[r]; 
RETURN 
END; 

OperandSize: TYPE = {single, double, field}; 

PtrLength: TYPE = [1. .2]; 

ReadOp: ARRAY OperandSize OF PACKED ARRAY PtrLength OF BYTE ■ 

[[FOpCodes. qR, FOpCodes . qRL] , [FOpCodes . qRD, FOpCodes . qRDL] , [FOpCodes . qRF , FOpCodes .qRFL]] ; 
WriteOp: ARRAY OperandSize OF PACKED ARRAY PtrLength OF BYTE - 

[[FOpCodes. qW, FOpCodes. qWL] , [FOpCodes .qWD, FOpCodes . qWDL] , [FOpCodes . qWF , FOpCodes .qWFL]]; 
RilOp: ARRAY PtrLength OF PACKED ARRAY BOOLEAN OF BYTE « 

[[ FOpCodes. qRIL, FOpCodes. qR IG] , [FOpCodes .qRILL, FOpCodes. qRIGL]] ; 
WilOp: ARRAY PtrLength OF PACKED ARRAY BOOLEAN OF BYTE - 

[[FOpCodes. qWIL, FOpCodes. qWIG] , [FOpCodes . qWILL, FOpCodes. qWIGL]]; 

Cptrload: PROCEDURE [r: BDOIndex] « 

BEGIN -- loads a type-bo BDOItem onto the stack 

OPEN FOpCodes; 

s.v, bv: CARDINAL; 

pi: CARDINAL; 

tlex: se Lexeme; 

rr: BDOIndex; 

1: ContextLevel «- cb[r]. base, level ; 

nb: CARDINAL; 

pi «- cb[r]. base. size/wordlength; 
v *r cb[r] .of f set .posn.wd; s «- cb[r].off set. size; 
bv *- cb[r]. base. posn.wd; 
IF v IN OpCodeParams.HB 
AND s ■ wordlength 
AND ((1 - IG AND bv IN OpCodeParams . GlobalHB) 

OR (1 ■ CPtr.curctxIvl AND bv IN OpCodeParams .LocalHB) ) 
AND pi IN [1. .2] THEN 
BEGIN 

Ciout2[RilOp[pl][l»lG], bv, v]; 
RETURN; 
END; 

pi <- MAX[pl,l]; 
IF 1 # 1TOS THEN 

BEGIN 

pushcomponent[basecomponent, r]; 

ENDr 
IF s - 2*wordlength THEN 

BEGIN Cioutl[ReadOp[double][pl], v]; END 
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ELSE IF s > wordlength THEN 
BEGIN 

tlex «- gentemplex[pl]; 
sCassign[tlex.lexsei]; 
UNTIL s-0 DO 

rr ♦• maketempaddrBDOItem[lpushlex[tlex]]; 
nb <- MIN[s,2*wordlength]; 
cb[rr]. offset <~ 

BDOComponent[level : ,posn: FullBitAddress[wd: v, bd: 0], size: nb]; 
Cptrload[rr]; 
v <- v+2; s <- s-nb; 
ENDLOOP; 
END 
ELSE IF s ■ wordlength THEN Cioutl[ReadOp[single][pl] , v] 
ELSE Ciout2[ReadOp[field][pl], v t FieldParam[r]]; 
releaseBDOItem[r]; 
RETURN 
END; 

Cindexedptrload: PROCEDURE [r: BDOIndex] ■ 
BEGIN OPEN FOpCodes; 

Cindexedptrmove[r,[qRXL,qRXLL,qRXGL],Cptrload]; 
END; 

Cindexedptrmove: PROCEDURE [r: BDOIndex, imoveop: PACKED ARRAY {local, locallong, globallong} OF BYTE 
**, cptrmove: PROCEDURE[BDOIndex]] - 

BEGIN -- loads a type-bdo BDOItem onto the stack 

OPEN FOpCodes; 

s: CARDINAL «- cb[r].off set . size; 

v: CARDINAL «- cb[r] .of f set . posn.wd; 

1: ContextLevel «- cb[r]. base, level ; 

bv: CARDINAL; 

baseOnStack, dispOnStack: BOOLEAN; 

onstack: CARDINAL <- 0; 

IF cb[r].disp.size > wordlength THEN basedispcommute[r]; 
dispOnStack <- cb[r] . disp. level - 1TOS; 
IF dispOnStack THEN 

onstack <- onstack+(cb[r].disp.size+wordlength-l)/wordlength; 
1 <- cb[r] .base, level ; 
baseOnStack «- 1 » 1TOS; 
IF baseOnStack THEN 

onstack *- onstack+(cb[r].base.size+wordlength-l)/wordlength; 
bv <- cb[r] .base. posn.wd; 
IF cb[r]. base. size > wordlength THEN 
BEGIN -- base long, disp unknown 
IF cb[r]. disp. size > wordlength THEN 
BEGIN 

RequireStack[onstack]; -- DADD is minimal stack 
pushcomponent[basecomponent , r]; 
pushcomponent[dispcomponent , r]; 
CioutO[qDADD]; 
END 
ELSE IF cb[r]. disp. size < wordlength THEN 
BEGIN 

RequireStack[onstack]; -- DADD is minimal stack 
IF dispOnStack AND -baseOnStack THEN 
BEGIN 

pushcomponent[dispcomponent, r]; 
Cioutl[qLI, 0]; 

pushcomponent[ base component, r]; 
END 
ELSE 
BEGIN 

pushcomponent[basecomponent , r]; 
pushcomponent[dispcomponent , r]; 
Cioutl[qLI, 0]; 
END; 
CioutO[qDADD]; 
END 
ELSE 

BEGIN -- long base, one word disp 
pushcomponent[dispcomponent , r]; 
IF -dispOnStack THEN 

onstack <*- onstack+(cb[r] .disp.size+wordlength-l)/wordlength; 
IF s - wordlength AND v IN OpCodeParams .HB THEN 
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IF 1 ■ 1G AND bv IN OpCodeParams .GlobalHB THEN 
BEGIN 

Ciout2[imoveop[g"loba1"long], bv, v]; 
releaseBDOItem[r]; 
RETURN; 
END 
ELSE IF 1 - CPtr.curctxlvl AND bv IN OpCodeParams. LocalHB THEN 
BEGIN 

Ciout2[imoveop[locallong], bv, v]; 
releaseBDOItem[r]; 
RETURN; 
END; 
RequireStack[onstack]; -- DADD is minimal stack 
Cioutl[qLI, 0]; -- or however we're supposed to lengthen it 
pushcomponent[basecomponent , r]; 
CioutO[qDADD]; 
END 
END 
ELSE 

BEGIN --base and disp both short 

IF cb[r]. base. level # CPtr.curctxlvl OR cb[r] .base. level a 1G 
OR cb[r]. base. size # wordlength 
THEN 
BEGIN 

basedispcommute[r]; ' 

1 *- cb[r] .base, level ; 
bv ♦- cb[r].base.posn.wd; 
END; 
IF v IN OpCodeParams. HB AND 1 * CPtr.curctxlvl 

AND cb[r] .base. size ■ wordlength AND s B wordlength THEN 
BEGIN 

IF cb[r] . disp. level ■ CPtr.curctxlvl 
AND cb[r] .disp. size ■ wordlength 
AND cb[r].disp.posn.wd < bv THEN 
BEGIN 

basedispcommute[r]; 
bv *- cb[r].base.posn.wd; 
END; 
IF bv IN OpCodeParams. LocalHB THEN 
BEGIN 

pushcomponent[dispcomponent , r]; 

Ciout2[imoveop[ local], cb[r].base.posn.wd, cb[r] .offset.posn.wd]; 
releaseBDOItem[r]; 
RETURN; 
END; 
END; 
pushcomponent[basecomponent, r]; 
pushcomponent[dispcomponent, r]; 
Ciout0[ qADD]; 
END; 
cb[r].tag «- bo; 
cptrmove[r]; 
RETURN 
END; 

Cstore: PUBLIC PROCEDURE [r: BDOIndex] ■ 
BEGIN -- generates code for Ins 
SELECT cb[r].tag FROM 

o ■> Cvarstore[r]; 

bo ■> Cptrstore[r]; 

bdo ■> Cindexedptrstore[r]; 

ENDCASE *> BEGIN AddressError[] ; releaseBDOItem[r] ; 
END; 
RETURN 
END; 

storelex: PUBLIC PROCEDURE [1: ContextLevel , wordoffset, nwords: CARDINAL] » 
BEGIN -- stores 1 or 2 words at Ivl 1, offset bitoffset, onto stack 
rr: BDOIndex «- genBDOItem[] ; 

cb[rr].tag «- o; 
cb[rr].of f set <- 

BDOComponent[level : 1, posn: FullBitAddress[wd: wordoffset, bd: 0], size: nwords*wordlength]; 
Cvarstore[rr]; 
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RETURN 
END; 



Cvarstore: PROCEDURE [r: BDOIndex] - 

BEGIN -- stores a type-o BDOItem from stack 

OPEN FOpCodes; 

1: ContextLevel +■ cb[r].off set. level ; 

v: CARDINAL «- cb[r] .of f set. posn .wd; 

s: CARDINAL <- cb[r] .of f set. size; 

g: BOOLEAN *- 1-1G; 

IF 1 ■ 1TOS THEN BEGIN AddressError[] ; releaseBDOItem[r] ; RETURN END; 
IF ~g AND 1 » CPtr.curctxlvl THEN 

BEGIN GetFrame[r]; Cstore[r]; RETURN END; 
IF s - 2*wordlength THEN 

BEGIN 

IF g THEN Cioutl[qSGD, v] ELSE Cioutl[qSLD, v]; 

releaseBDOItem[r]; 

RETURN 

END; 
IF s > wordlength THEN 

BEGIN 

s «- s/wordlength; 

v ♦- cb[r], offset. posn. wd + s; 

THROUGH [1..S/2] DO 

v ♦■ v-2; storelex[l, v, 2]; s <- s-2; ENDLOOP; 

IF s # THEN storelex[l, v-1, 1]; 

releaseBDOItem[r]; 

RETURN 

END; 
IF s < wordlength THEN 

BEGIN loadaddr[r]; Cptrstore[r] ; RETURN END; 
IF g THEN Cioutl[qSG, v] ELSE Cioutl[qSL, v]; 
releaseBDOItem[r]; 
RETURN 
END; 



Cptrstore: PROCEDURE [r: BDOIndex] ■ 

BEGIN -- stores a type-bo BDOItem from the stack 

OPEN FOpCodes; 

s,v, bv: CARDINAL; 

pi: CARDINAL; 

tlex: se Lexeme; 

rr: BDOIndex; 

1: ContextLevel <- cb[r]. base, level ; 

nb: CARDINAL; 

pi <- cb[r] .base.size/wordlength; 

v <- cb[r]. offset. posn. wd; s <- cb[r]. off set. size; 

bv «- cb[r] .base. posn. wd; 

IF v IN OpCodeParams.HB 
AND s • wordlength 
AND ((1 = 1G AND bv IN OpCodeParams . GlobalHB) 

OR (1 ■ CPtr.curctxlvl AND bv IN OpCodeParams .LocalHB) ) 
AND pi IN [1..2] THEN 
BEGIN 

Ciout2[WilOp[pl][l-lG], bv, v]; 
RETURN; 
END; 

pi ♦- MAX[pl,l]; 
IF 1 # 1TOS THEN 

BEGIN 

pushcomponent[basecomponent, r]; 

END; 
IF s - 2*wordlength THEN 

BEGIN Cioutl[WriteOp[double][pl], v]; END 
ELSE IF s > wordlength THEN 

BEGIN 

tlex «- gentemplex[pl]; 

v <- v+s/wordlength; 

sCassign[tlex.lexsei]; 
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UNTIL s«0 DO 

rr <- maketempaddrBDOItem[lpushlex[tlex]]; 

nb <- MIN[s,2*wordlength]; 

v 4- v-nb/wordlength; 

cb[rr], offset «- 

BDOComponent[level : ,posn: FullBitAddress[wd: v, bd: 0], size: nb]; 

Cptrstore[rr]; 

s «- s-nb; 

ENDLOOP; 
END 
ELSE IF s - wordlength THEN Cioutl[WriteOp[single][pl] , v] 
ELSE Ciout2[WriteOp[field][pl], v, FieldParam[r]]; 
releaseBDOItem[r]; 
RETURN 
END; 

Cindexedptrstore: PROCEDURE [r: BDOIndex] ■ 
BEGIN OPEN FOpCodes; 

Cindexedptrmove[r,[qWXL,qWXLL,qWXGL],Cptr store]; 
END; 

Cindex: PUBLIC PROCEDURE [node: Treelndex] RETURNS [Lexeme] - 
BEGIN -- generates code for array indexing 
r, rr: BDOIndex; 

s: CARDINAL «- wordlength * SymTabDef s .WordsForType[(tb+node) . info] ; 
offset: BDOComponent; 
la: bdo Lexeme; 
alpha: INTEGER; 
onstack, simple: BOOLEAN; 
arraytype: CSEIndex; 

treeinserted, suminserted, packed: BOOLEAN <- FALSE; 
t2: TreeLink; 

mwcOffset, psize: CARDINAL; 
freet2: PROCEDURE ■ 
BEGIN 

WITH t2 SELECT FROM 
subtree a > 

BEGIN (tb+index) .sonl «- TreeDefs. empty ; 
TreeDefs. freenode[ index]; 
END; 
ENDCASE => P5ADefs.P5Error[322]; 
END; 

t2 *■ (tb+node) .son2; 

arraytype «- operandtype[(tb+node) .sonl]; 
WITH a:(seb+arraytype) SELECT FROM 
array => 

IF a. packed AND 

SymTabDefs.BitsForType[a.componenttype] <= 8 THEN 
packed <- TRUE; 
ENDCASE; 
BEGIN 

la ♦- makeBDOItem[Cexp[(tb+node) .sonl 
IMWConstant--[cOffset]~- -> 

IF packed OR s # wordlength THEN 

RESUME [ gen temp lex[ SymTabDef s. Words ForType[ array type]]] 
ELSE BEGIN mwcOffset <- cOffset; GO TO useRFC END]]; 
EXITS useRFC »> 

BEGIN -- can't get here if store or t2 constant 
r <- makeTOSaddrBDOItem[wordlength]; -- ignoring the base 
cb[r] .off set.posn.wd *- mwcOffset; 
[t2, treeinserted] <- checkadditivity[t2 t r]; 
pushrhs[t2]; 

mwcOffset ♦• cb[r]. offset. posn.wd; 
IF mwcOffset > LAST[BYTE] THEN 
BEGIN 

pushlitval[mwcOffset-LAST[BYTE]]; 
mwcOffset «• LAST[BYTE]; 
Ciout0[ FOpCodes. qADD]; 
END; 
Ciout2[ FOpCodes. qRFC, mwcOffset, 

LOOPHOLE[ControlDefs.FieldDescriptor[offset:0, posn:0 f size: word length]]]; 
IF treeinserted THEN freet2[]; 
RETURN[topostack] 
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END; 
END; 

r *- la.lexbdoi ; 
onstack «- cb[r].tag ■ AND cb[r]. offset. level ■ 1T0S; 

IF packed THEN 
BEGIN 

IF cb[r].tag - THEN alpha «- 
ELSE 

BEGIN 

alpha «- 2 * cb[r].off set.posn.wd; 

cb[r]. offset <- WordZeroBDOComponent; 

END; 
psize «- loadaddress[r]; 

RETURN[packedarrayelement[t2, alpha, psize>wordlength]]; 
END; 

IF treeliteral[t2] THEN 

BEGIN 

IF ~ onstack THEN 
BEGIN 

cb[r]. off set. size <- s; 
cb[r]. off set.posn.wd *• 

cb[r]. off set.posn.wd + treel iteralvalue[t2]; 
RETURN [la] 
END; 

END 
ELSE 

[t2, treeinserted] «- checkadditivity[t2, r]; 
BEGIN 
SELECT cb[r].tag FROM 

=> simple <- TRUE; 

bo ■> GO TO alreadybo; 

bdo «> simple «- FALSE; 

ENDCASE; 
IF -simple THEN 

BEGIN offset ♦■ cb[r]. offset; cb[r]. offset «- WordZeroBDOComponent; END; 
psize «- loadaddress[r]; 

la.lexbdoi «- r «- makeTOSaddrBDOItem[psize]; 
IF -simple THEN cb[r]. offset ♦■ offset; 
EXITS 

alreadybo ■> NULL; 
END; 

cb[r]. off set. size «- s; 
IF onstack AND treel iteral[t2] THEN -- i.e. didn't get caught above 

BEGIN 

cb[r].off set.posn.wd <- 

cb[r]. offset. posn.wd + tree! iteralvalue[t2]; 

RETURN [la] 

END; 
cb[r].tag <- bdo; 
rr *- rmakeBD0Item[Cexp[t2]]; 
IF cb[rr].tag - THEN 

BEGIN cb[r].disp *- cb[rr] .off set; releaseBDOItem[rr] END 
ELSE BEGIN Cload[rr]; cb[r].disp <- TosBDOComponent END; 
IF treeinserted THEN freet2[]; 
RETURN [la] 
END; 

checkadditivity: PROCEDURE [t: TreeLink, r: BDOIndex] RETURNS [rt: TreeLink, insertedtree: BOOLEAN] 

BEGIN OPEN TreeDefs; 
node: Treelndex; 
p: BOOLEAN; 

insertedtree «- FALSE; 
rt *- t; 

WITH t SELECT FROM 
subtree ■> 

BEGIN node <- index; 

IF (p <- (tb+node) .name - plus) OR (tb+node) .name - minus THEN 
IF treeliteral[(tb+node).sonl] THEN 
BEGIN 
cb[r], off set.posn.wd *- 

cb[r], off set.posn.wd + treeliteralvalue[(tb+node) .sonl]; 
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IF ~p THEN 
BEGIN 

mlpush[(tb+node) ,son2]; pushtree[uminus, 1]; 
setinfo[MPtr.typeINTEGER]; 
setattr[l, FALSE]; rt <- mlpop[]; 
insertedtree <- TRUE; 
END 
ELSE rt <- (tb+node).son2; 
END ELSE 
IF treeliteral[(tb+node) .son2] 

AND (p OR treeliteralvalue[(tb+node).son2] <» cb[r] .of f set.posn .wd) THEN 
BEGIN 
cb[r]. offset. posn.wd «- IF p THEN 

cb[r].off set.posn. wd+t reel iteralva1ue[( tb+node) .son2] 
ELSE cb [ r ]. of fset.posn.wd-treeliteralvalue[( tb+node) .son2]; 
rt «- (tb+node) .sonl; 
END; 
END; 
ENDCASE; 
RETURN 
END; 

Cdindex: PUBLIC PROCEDURE [node: Treelndex] RETURNS [Lexeme] ■ 
BEGIN -- generates code for indexing from an array descriptor 
Id: bdo Lexeme; 
r, rr: BDOIndex; 

treeinserted, suminserted: BOOLEAN «- FALSE; 
arraytype, arraydtype: CSEIndex; 
tl, t2: TreeLink; 
psize: CARDINAL; 

tl <- (tb+node) .sonl; 

t2 <- (tb+node) .son2; 

arraydtype «- SymTabDef s.NormalType[operandtype[tl]]; 

Id «- makeBDOItem[Cexp[tl]]; 

r <- Id. lexbdoi ; 

IF cb[r].tag = o AND cb[r]. offset. level ■ 1T0S THEN 

Ciout0[FOpCodes.qP0P]; 
cb[r]. offset. size <- cb[r], offset . size-wordlength; 
psize <- cb[r]. offset. size; 
WITH (seb+arraydtype) SELECT FROM 
arraydesc a > 
BEGIN 

arraytype «- SymTabDef s.UnderType[describedType]; 
WITH (seb+arraytype) SELECT FROM 

array => IF -packed OR SymTabDef s.BitsForType[componenttype] > 8 THEN 

GO TO notpacked; 
ENDCASE; 
Cload[r]; 

RETURN[packedarrayelement[t2, 0, psize>wordlength]]; 
EXITS 

notpacked -> NULL; 
END; 
ENDCASE; 
IF cb[r].tag - o THEN 
IF cb[r]. offset. level = 1TOS THEN 
BEGIN 

Cvarload[r]; 

Id. lexbdoi <- r «- makeTOSaddrBDOItem[psize]; 
END 
ELSE 
BEGIN 

cb[r].base ♦- cb[r] .off set; 
cb[r].tag «- bo; 

cb[r]. offset ♦- WordZeroBDOComponent; 
END 
ELSE 
BEGIN 

pushlex[ld]; 

Id. lexbdoi «- r «- makeTOSaddrBDOItem[psize]; 
END; 
cb[r]. off set. size *- word 1 en g th*SymTabDef s. Words ForType[( tb+node) . info]; 
IF treeliteral[t2] THEN 

BEGIN cb[r]. offset. posn.wd «- tree! iteralvalue[t2]; RETURN [Id] END 
ELSE [t2 f treeinserted] ♦- checkadditivity[t2, r]; 
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rr «- rmakeBD0Item[Cexp[t2]]; 

cb[r].tag ♦- bdo; 

IF cb[rr].tag ■ o THEN 

BEGIN cb[r].disp «- cb[rr] .of fset ; releaseBDOItem[rr] END 
ELSE BEGIN Cload[rr]; cb[r].disp <- TosBDOComponent END; 
IF treeinserted THEN WITH t2 SELECT FROM 

subtree ■> 

BEGIN (tb+index) .sonl «- TreeDefs .empty; TreeDef s.f reenode[index]; END; 

ENDCASE ■> P5ADefs.P5Error[323]; 
RETURN [Id] 
END; 

packedarrayelement: PROCEDURE [t2: TreeLink, alpha: INTEGER, long: BOOLEAN] RETURNS [Lexeme] ■ 
BEGIN — @a[0] is on stack, eval[t2]+alpha is index 
constindex: BOOLEAN; 

treeinserted, suminserted: BOOLEAN «- FALSE; 
addend: INTEGER; 
addback: INTEGER <- 0; 

constindex <- tree! iteral[t2]; 
IF constindex THEN 

addend «- treel iteral value[t2] 
ELSE [addend, t2, treeinserted] <- extractconstant[t2]; 
alpha ♦■ alpha + addend; 
IF constindex THEN 
BEGIN 

SELECT alpha FROM 
< -> 
BEGIN 

pushl itval[alpha]; 
alpha «- 0; 
END; 
IN BYTE «> pushlitval[0]; 
ENDCASE »> 
BEGIN 

addback <- alpha-LAST[BYTE]; 
alpha <- LAST[BYTE]; 
pushl itval [addback]; 
END; 
RETURN [Lexeme[other[byte[lexalpha:alpha, long:long]]]]; 
END; 
SELECT alpha FROM 
< »> 

BEGIN addback <- alpha; 
alpha <- 0; 
END; 
IN BYTE «> NULL; 
ENDCASE -> 

BEGIN addback <- alpha-LAST[BYTE]; 

alpha <- LAST[BYTE]; 

END; 

IF addback # THEN 

BEGIN t2 <- putbackconstant[t2, addback]; suminserted *- TRUE; END; 
Cload[rmakeBDOItem[Cexp[t2]]]; 

IF suminserted OR treeinserted THEN WITH t2 SELECT FROM 
subtree ■> 

BEGIN (tb+index) .sonl «- TreeDefs. empty; 
IF suminserted THEN (tb+index) . son2 «- TreeDef s. empty; 
TreeDef s.f reenode[ index]; 
END; 
ENDCASE «> P5ADefs.P5Error[324]; 
RETURN [Lexeme[other[byte[lexalpha:alpha, long: long]]]] ; 
END; 

extractconstant: PROCEDURE [t: TreeLink] RETURNS [val : INTEGER, rt: TreeLink, insertedtree: BOOLEAN] 

BEGIN OPEN TreeDefs; 
node: Treelndex; 
p: BOOLEAN; 

insertedtree «- FALSE; 

val ♦- 0; 

rt <- t; 

WITH t SELECT FROM 
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subtree ■> 

BEGIN node <- index; 

IF (p <- (tb+node) .name ■ plus) OR (tb+node) .name ■ minus THEN 
IF treeliteral[(tb+node).sonl] THEN 
BEGIN 

val «~ tree! iteralvalue[(tb+node) .sonl]; 
IF ~p THEN 
BEGIN 

mlpush[(tb+node) .son2]; pushtree[uminus, 1]; 
setinfo[MPtr.typeINTEGER]; 
setattr[l, FALSE]; rt <- mlpop[]; 
insertedtree «- TRUE; 
END 
ELSE rt <- (tb+node). son2; 
END ELSE 
IF treeliteral[(tb+node).son2] THEN 
BEGIN 

val *- treeliteralvalue[(tb+node) ,son2]; 
IF ~p THEN val ♦- -val; 
rt <- (tb+node) .sonl; 
END; 
END; 
ENDCASE; 
RETURN 
END; 

putbackconstant: PROCEDURE [t: TreeLink, val: INTEGER] RETURNS [rt: TreeLink] 
BEGIN OPEN TreeDefs; 
node: Treelndex; 
lt1: LTIndex; 
p: BOOLEAN <- TRUE; 
m: BOOLEAN «- vaKO; 
rt <- t; 

WITH t SELECT FROM 
subtree ■> 

BEGIN node <- index; 
IF (tb+node) .name ■ uminus THEN 
BEGIN p «- FALSE; 
rt «- (tb+node) .sonl; 
(tb+node) .sonl <- empty; 
f reenode[index]; 
END; 
END; 
ENDCASE; 
IF p THEN 
BEGIN 

Ui *- LitDefs.FindLiteral[ABS[val]]; 
mlpush[rt]; pushl ittree[l ti]; 
pushtree[IF m THEN minus ELSE plus, 2]; 
END 
ELSE 
BEGIN 

Hi <- LitDefs.FindLiteral[val]; 
pushlittree[lti]; mlpush[rt]; 
pushtree[minus, 2]; 
END; 
setinfo[MPtr.typeINTEGER]; 
setattr[l t FALSE]; rt «- mlpop[]; 
RETURN 
END; 



GetFrame: PUBLIC PROCEDURE [r: BDOIndex] - 
BEGIN -- gets back to frame at level 1 
1: ContextLevel <- cb[r] .of f set. level ; 
rr: BDOIndex; 
FLoffsetFromL: BDOComponent «- 

[size: wordlength, level: CPtr .curctxlvl , posn: Ful IBi tAddress[bd: 0, wd: framelink]]; 
FLoffset: BDOComponent «- 

[size: wordlength, level: 1Z, posn: FullBitAddress[bd: 0, wd: frame! ink-localbase]]; 

IF cb[r].tag # o THEN P5ADef s. P5Error[325]; 

IF CPtr. curctxlvl - 1 THEN RETURN; 

cb[r]. offset, level «- 1Z; 

cb[r]. off set. posn. wd <- cb[r] .of fset. posn.wd-localbase; 
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cb[r].tag ♦- bo; 

IF CPtr.curctxlvl ■ 1+1 THEN 

BEGIN cb[r].base <- FLoffsetFromL; RETURN END; 
rr <- genBDOItem[]; 
cb[rr].tag <- bo; 
cb[rr]. offset ♦■ FLoffset; 
cb[rr].base ♦■ FLoffsetFromL; 
Cptrload[rr]; 
THROUGH (1.. CPtr.curctxlvl-1) DO 

rr <- genBDOItem[]; 

cb[rr].tag <- bo; 

cb[rr]. offset <- FLoffset; 

cb[rr].base «- TosBDOComponent; 

Cptrload[rr]; 

ENDLOOP; 
cb[r].base ♦- TosBDOComponent; 
RETURN 
END; 

FullWordBits: PUBLIC PROCEDURE [bits: CARDINAL] RETURNS [CARDINAL] ■ 
BEGIN 

RETURN[((bits+wordlength-l)/wordlength) * wordlength] 
END; 

pushcomponent: PUBLIC PROCEDURE [t: BDOComponentNames, r: BDOIndex] ■ 
BEGIN -- pushes base, disp, or offset from lrrecord onto stack 
rr: BDOIndex «- genBDOItem[j; 
tos: BDOComponent; 

SELECT t FROM 

basecomponent ■> cb[rr] .off set <- cb[r].base; 

dispcomponent ■> cb[rr] .off set <- cb[r].disp; 

off setcomponent ■> cb[rr]. offset <- cb[r]. offset; 

ENDCASE; 
cb[rr].tag «- o; 

tos «- [level: 1T0S, posn: FullBitAddress[O f 0], size: Ful lWordBits[cb[rr], off set . size]]; 
Cload[rr]; 
SELECT t FROM 

basecomponent ■> cb[r].base <- tos; 

dispcomponent => cb[r].disp «- tos; 

off setcomponent «> cb[r]. offset <- tos,* 

ENDCASE; 
RETURN 
END; 

basedispcommute: PROCEDURE [r: BDOIndex] » 
BEGIN -- commutes base and disp components 
rr: BDOComponent; 

rr <- cb[r].base; 
cb[r].base «- cb[r].disp; 
cb[r].disp <- rr; 
RETURN 
END; 

loadtsonchars: PUBLIC PROCEDURE [t: TreeLink, nchars: CARDINAL] - 
BEGIN -- t is an expression of type packed array, load 
-- nchars O 4 onto stack 
-- called from Cfrel and Crel 
IF t - empty THEN 
BEGIN 
IF ~CPtr f i rs tcasesel read THEN 

THROUGH [l..(nchars+l)/2] DO CioutO[FOpCodes. qPUSH] ; ENDLOOP 
ELSE CPtr.firstcaseselread ♦- FALSE; 
RETURN; 
END; 
pushrhs[t]; -- load full words in this case; 
IF nchars MOD 2 - 1 THEN 
BEGIN 

pushlitval[177400B]; 
CioutO[FOpCodes.qAND]; 
END; 
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RETURN 
END; 

BDOcount: PUBLIC INTEGER; 
BDOcard: PUBLIC INTEGER; 

genBDOItem: PUBLIC PROCEDURE RETURNS [r: BDOIndex] - 
BEGIN -- returns the cb-relative index of a "Irrecord 
BDOcount <- BDOcount + 1; 
r <- BDOItemlist; 

IF r # BDONull THEN BDOItemlist ♦- cb[r]. thread 
ELSE 

BEGIN r <- CodeDefs.GetChunk[SIZE[BDOItem]]; BDOcard <- BDOcard + 1 END; 
cb[r]. thread «- InUseThread; 
RETURN 
END; 

releaseBDOItem: PUBLIC PROCEDURE [r: BDOIndex] - 
BEGIN -- returns Irrecord to free pool 
BDOcount «- BDOcount - 1; 
IF cb[r]. thread # InUseThread THEN 

BEGIN SIGNAL Inval idBDOItemRel ease; RETURN END; 
cb[r], thread «- BDOItemlist; 
BDOItemlist ♦- r; 
RETURN 
END; 

END... 



